home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Delphi Developer's Kit 1996
/
Delphi Developer's Kit 1996.iso
/
power
/
formset
/
formset.~pa
next >
Wrap
Text File
|
1995-12-22
|
5KB
|
168 lines
unit Formset;
interface
uses
SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
Forms, Dialogs, Tabs;
type
TFTOpen = (ftoSizeBookToPage, ftoSizePageToBook);
TFTClose = (ftcNeverRelease, ftcAlwaysRelease, ftcMaybeRelease);
TFormTab = class
Form : TForm;
OnOpen : TFTOpen;
OnClose : TFTClose;
end;
TTabLoadEvent = procedure(Sender: TObject;
TabIndex: Integer;
FormTab: TFormTab) of object;
TFormSet = class(TTabSet)
private { Private declarations }
FOnClick : TNotifyEvent;
FOnChange : TTabChangeEvent;
FOnTabLoad : TTabLoadEvent;
OldTabIndex : Integer;
InternalChange : Boolean;
ParentHeight : Integer;
ParentWidth : Integer;
Procedure TabClose(OldTabIndex: Integer);
Procedure TabOpen( NewTabIndex: Integer);
Function ConfigureTab(TabIndex: Integer): Boolean;
constructor Create(aOwner: TComponent); override;
protected { Protected declarations }
procedure Click; override;
public { Public declarations }
published { Published declarations }
property OnClick : TNotifyEvent read FOnClick write FOnClick;
property OnChange : TTabChangeEvent read FOnChange write FOnChange;
property OnTabLoad : TTabLoadEvent read FOnTabLoad write FOnTabLoad;
end;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('Samples', [TFormSet]);
end;
constructor TFormSet.Create;
begin
inherited Create(aOwner);
OldTabIndex := TabIndex;
InternalChange := False;
end;
Function TFormSet.ConfigureTab;
var
FormTab : TFormTab;
begin
FormTab := Tabs.Objects[TabIndex] as TFormTab;
if not assigned(FormTab) then
begin
FormTab := TFormTab.Create;
Tabs.Objects[TabIndex] := FormTab;
end;
if not assigned(FormTab.Form) then
if assigned(FOnTabLoad) then
FOnTabLoad(Self,TabIndex,FormTab);
Result := assigned(FormTab.Form);
{
if not Result then
ShowMessage('Cannot open this tab. No form specified.');
}
end;
procedure TFormSet.TabOpen;
var
FormTab : TFormTab;
Child : TForm;
begin
FormTab := Tabs.Objects[NewTabIndex] as TFormTab;
Child := FormTab.Form;
if ParentHeight = 0 then ParentHeight := Parent.ClientHeight;
if ParentWidth = 0 then ParentWidth := Parent.ClientWidth;
if FormTab.OnOpen = ftoSizePageToBook then
begin
Parent.ClientHeight := ParentHeight;
Parent.ClientWidth := ParentWidth;
end;
if FormTab.OnOpen = ftoSizeBookToPage then
begin
Parent.ClientHeight := Child.Height;
Parent.ClientWidth := Child.Width;
end;
Child.Parent := Parent;
Child.Align := alClient;
Child.BorderStyle := bsNone;
Child.Visible := True;
end;
procedure TFormSet.TabClose;
var
FormTab : TFormTab;
begin
if OldTabIndex < 0 then exit;
FormTab := Tabs.Objects[OldTabIndex] as TFormTab;
if not assigned(FormTab) then
exit;
if FormTab.OnClose = ftcAlwaysRelease then
begin
FormTab.Form.Release;
FormTab.Form := Nil;
end
else
begin
FormTab.Form.Hide;
FormTab.Form.Parent := Nil;
end;
end;
procedure TFormSet.Click;
var
AllowChange : Boolean;
NewTabIndex : Integer;
FormTab : TFormTab;
begin
if InternalChange
or (TabIndex = OldTabIndex) then
exit;
InternalChange := True; { Prevent too much recursion }
NewTabIndex := TabIndex; { Temporarily undo TabIndex change }
TabIndex := OldTabIndex;
AllowChange := True;
if OldTabIndex >= 0 then
begin
FormTab := Tabs.Objects[OldTabIndex] as TFormTab;
if assigned(FormTab.Form) then
AllowChange := FormTab.Form.CloseQuery;
end;
If AllowChange then
AllowChange := ConfigureTab(NewTabIndex);
if AllowChange then
if assigned(FOnChange) then
fOnChange(Self,NewTabIndex,AllowChange);
if AllowChange then
begin
TabClose(OldTabIndex);
TabOpen(NewTabIndex);
TabIndex := NewTabIndex;
OldTabIndex := NewTabIndex;
if assigned(FOnClick) then
OnClick(Self);
end;
InternalChange := False;
end;
Initialization
end.